home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / graphic / 1svga.zip / COLOR.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  973b  |  39 lines
  1. { Show EGA 64 Colors }
  2.  
  3. uses Txt;
  4.  
  5. { ─────────────── ShowColor ─────────────── }
  6. procedure ShowColor(X,Y,LenX:integer);
  7. var I,K,P:integer;
  8.     St:string[2];
  9.     C:array[0..16] of byte;
  10. begin
  11.   P:=1;
  12.   TextBar(1, 1,80,1,$1F,' ');
  13.   TextBar(1,25,80,1,$1F,' ');
  14.   PrintChar(3, 1,'Show EGA 64 Colors');
  15.   PrintChar(3,25,'Up,Down,PgUp,PgDn,Home,End-Scroll colors   Esc-Exit');
  16.   repeat
  17.     for I:=1 to 15 do C[I]:=P+I-1; C[0]:=1; C[16]:=0;
  18.     SetPalette17(C);
  19.     for I:=0 to 14 do begin
  20.       Str(P+I:2,St); PrintText(X,Y+I,15,St);
  21.       TextBar(X+3,Y+I,LenX,1,I+1,'█');
  22.     end;
  23.     K:=Key;
  24.     case K of
  25.       $4800:Dec(P);   $5000:Inc(P);    { Up,Down }
  26.       $4900:Dec(P,8); $5100:Inc(P,8);  { PgUp,PgDn }
  27.       $4700:P:=1;     $4F00:P:=49;     { Home,End }
  28.     end;
  29.     if P<1 then P:=1; if P>49 then P:=49;
  30.   until K=$011B;  { Esc }
  31. end;
  32.  
  33. begin
  34.   VideoMode(3);
  35.   TextBar(1,1,80,25,7,' ');
  36.   ShowColor(18,6,40);
  37.   VideoMode(3);
  38. end.
  39.